perm filename CTRLC.SAI[PUB,TES]1 blob
sn#129298 filedate 1974-11-04 generic text, type T, neo UTF8
00100 BEGOF("CTRLC")
00200 COMMENT
00300
00400 Control characters are detected by the break table of SCAN. TURN
00500 ON/OFF attempt to keep that break table current. Outer block control
00600 characters that have been redefined are stacked on ISTK in TURNTYPE
00700 records.
00800
00900 ;
01000 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE CTRLC! ;$"#
00200 BEGIN "CTRLC!"
00300 INTEGER J ;
00400 STRING S ;
00500 J ← 0 ;
00600 PJ 5/27/74 ITS does not like <control-C>'s;
00700 FOR S ← CR, ALTMODE&"{", RUBOUT, "α", 3, "#", "\", "∂", "←", "→", "∞",
00800 "↑", "↓", "]", "-", ".!?", SP, "_", "π", "∪", "∩", VT, "$", "%",
00900 "⊗", "[", "&" DO
01000 COMMENT 2D CHARS OF DIPHTHONGS COME NOT BEFORE [ IN LIST ↑ ;
01100 BEGIN J←J+1; WHILE FULSTR(S) DO DPB(J, SPCHAR(LOP(S))) ; END ;
01200 AMSAND ← J ; LBRACK ← J-1 ; UNDERBAR ← 18 ; UARROW ← 12 ; DARROW ← 13 ;
01300 LCURLY ← 2 ; DOLLAR ← 23 ; XCMDCHR ← 25 ;
01400 FOR S ← SP, TB, FF, VT, CR, LF, 0 DO CHARTBL[S] ← CHARTBL[S] LOR TWO(6) ;
01500 CHARSP ← CR & ALTMODE & RUBOUT & "α"&3&"#\∂←→∞↑↓]-? _π∪∩" & VT & "$%⊗[&" ;
01600 END "CTRLC!" ;
00100 PUBLIC SIMPLE PROCEDURE DSNEAK ;$"#
00200 BEGIN "DSNEAK" TES 11/4/74 ;
00300 STRING PIECE ;
00400 BOOLEAN SPECIAL ;
00500 SPECIAL ← FALSE ;
00600 IF NOPGPH THEN
00700 BEGIN
00800 PGPHSTART ;
00900 IF VERBATIM THEN DBREAK ;
01000 END ;
01100 PASS ;
01200 IFC PARCVER THENC
01300 IF ITSV(PARCMNEMONIC) THEN BEGIN PASS ; SPECIAL ← TRUE END ;
01400 ENDC
01500 PIECE ← MASH(E(NULL, NULL)) ;
01600 IF SPECIAL THEN PIECE ← 63&PIECE ;
01700 EMITPIECE(FONTCHAR & "π" & LENGTH(PIECE) & PIECE, 0, 0) ;
01800 END "DSNEAK" ;
00100 PUBLIC SIMPLE PROCEDURE DTURN(BOOLEAN TURNON) ;$"#
00200 BEGIN
00300 comment TURN ON|OFF {"c" [FOR "c"]},... ;
00400 INTEGER C1, C2 ; STRING S1, S2 ;
00500 PASS ;
00600 IF THISTYPE>INTERNTYPE OR THISTYPE=-TERQ OR NEXTSCH(:) OR NEXTSCH(←) THEN
00700 BEGIN "TURN BACK"
00800 IF ON THEN TES 9/23/74 ;
00900 BEGIN
01000 C1 ← IHED ;
01100 WHILE C1>0 AND (C2←IXTYPE(C1)) NEQ MODETYPE AND (C2 NEQ TURNTYPE OR ISTK[C1-1]<0) DO
01200 C1 ← IXOLD(C1) ;
01300 IF C2=TURNTYPE THEN DO
01400 BEGIN
01500 TURN((C2←ISTK[C1-1]) LSH -7,C2 LAND '177,1) ;
01600 ISTK[C1-1] ← -2 ;
01700 C1 ← IXOLD(C1) ;
01800 END
01900 UNTIL C1 LEQ 0 OR IXTYPE(C1) NEQ TURNTYPE OR ISTK[C1-1]<0 ;
02000 END ;
02100 END "TURN BACK"
02200 ELSE BEGIN "TURN CHARS"
02300 IF ON THEN TES 9/23/74 ;
02400 BEGIN
02500 PUSHI(TURNWDS, TURNTYPE) ;
02600 ISTK[IHED-1] ← -1 ;
02700 END ;
02800 DO BEGIN
02900 IF ITSCH(<,>) THEN PASS ;
03000 S1 ← IF NOT ITS(TAB) THEN SIMPAR ELSE TB ; PASS ;
03100 COMMENT 2/27/73 TES ;
03200 IF ITS(FOR) THEN
03300 BEGIN
03400 PASS ;
03500 S2 ← SIMPAR ;
03600 PASS ;
03700 END
03800 ELSE IF TURNON THEN S2 ← S1
03900 ELSE S2 ← NULL ;
04000 IF ON THEN
04100 BEGIN
04200 IF 0 NEQ LENGTH(S2) NEQ LENGTH(S1) THEN
04300 WARN(NULL,"Strings each side of FOR are unequal length") ;
04400 WHILE FULSTR(S1) DO
04500 TURN(LOP(S1), IF FULSTR(S2) THEN LOP(S2) ELSE 0, TURNON) ;
04600 END ;
04700 END UNTIL NOT ITSCH(<,>) ;
04800 END "TURN CHARS" ;
04900 END "DTURN" ;
00100 PRIVATE SIMPLE BOOLEAN PROCEDURE ENDOFSEGMENT ;$"#
00200 RETURN(NULSTR(INPUTSTR) OR INPUTSTR=CR OR LDB(SPCODE(INPUTSTR))=LCURLY) ;
00100 PRIVATE INTEGER PROCEDURE FIND!CHR(INTEGER CHR) ;$"#
00200 BEGIN "FIND!CHR"
00300 INTEGER I, B ;
00400 FOR I ← LENGTH(DEFN!BRC)-LDEFN!BRC STEP -1 UNTIL 1 DO
00500 IF DEFN!BRC[I FOR 1] = CHR THEN
00600 BEGIN B ← I ; DONE END ;
00700 RETURN(B) ;
00800 END "FIND!CHR" ;
00100 PUBLIC RECURSIVE PROCEDURE SCANTEXT ;$"#
00200 BEGIN "SCANTEXT"
00300 INTEGER N, CHR, F ;
00400 BOOLEAN PLUS ;
00500 STRING PIECE ;
00600 LABEL ENDERLINE ;
00700 TEXTMODE ← TRUE ; TES 8/23/74 ;
00800 WHILE TEXTMODE DO
00900 BEGIN
01000 IF FULSTR(PIECE ← RD(TEXT!TBL)) THEN EMIT(PIECE) ;
01100 IF BRC NEQ CR AND SIGNALD[BRC] AND SIGNA(BRC) THEN BEGIN COMMENT Responded to signal ; END
01200 ELSE CASE CHARTBL[BRC] LAND '77 OF
01300 BEGIN COMMENT BY BRC ;
01400 COMMENT 0 ; EMIT(BRC) ;
01500 COMMENT 1 ... CR ;
01550 BEGIN SUPERSUB←HEIGHT←AMPPOSN←RIPTPOSNS←0 ;
01600 IF FILL AND CRSPACE THEN EMSPACES(IF SPCS OR NOT POSN THEN 0 ELSE IF PUNC THEN 2 ELSE 1)
01700 ELSE IF IMPOSE THEN
01800 BEGIN "SUPERIMPOSE"
01900 IF (N ← SINCELFM+1) > TWEENLFM THEN DBREAK
02000 ELSE BEGIN EMIT(NULL); APPEND(CR & SPS(LMARG+(POSN←INDENT))); SINCELFM ← N ;
02100 TABI←MIDWORD←STARPOSN←FAKE←0 ; LBK←3; LBF←NULL; OKCR(FALSE) END ;
02200 END "SUPERIMPOSE"
02300 ELSE DBREAK ;
02400 TEXTMODE ← FALSE ;
02500 END ;
02600 COMMENT 2 ... Altmode or { ; TEXTMODE ← FALSE ;
02700 COMMENT 3 ... Rubout;
02750 IF ON THEN
02800 BEGIN "LABEL REF"
02900 N ← CVD(SCAN(INPUTSTR,TO!VT!SKIP,F)) ;
03000 IF XCRIBL THEN
03100 BEGIN
03200 EMIT(S←"01234567890123456789012345678901234567890123456789"[1 FOR N]);
03300 FAKE←FAKE+XLENGTH(S);
03400 END
03500 ELSE
03600 BEGIN
03700 EMIT(SPS(N)); FAKE←FAKE+N;
03800 END;
03900 OAKS←OAKS-N;
04000 APPEND(VT&SCAN(INPUTSTR, TO!VT!SKIP, F)&ALTMODE) ;
04100 END "LABEL REF"
04200 ELSE FOR N ← 1,2 DO SCAN(INPUTSTR, TO!VT!SKIP, F) ;
04300 COMMENT 4 ... α ;
04350 IF FULSTR(INPUTSTR) AND INPUTSTR NEQ ALTMODE THEN
04375 IF (N←LOP(INPUTSTR))=CR THEN TEXTMODE ← FALSE
04500 ELSE IF XCRIBL THEN
04600 IF (F←LDB(SPCODE(N))) = XCMDCHR THEN
04700 BEGIN EMIT(N); APPEND(N) END
04800 ELSE EMIT(N)
04900 ELSE EMIT(N);
05100 COMMENT 5 ... ↑C ; IF FILL THEN OKCR(FALSE) ELSE EMIT(BRC) ;
05200 COMMENT 6 ... # ; EMIT(SP) ;
05300 COMMENT 7 ... \ ;
05350 IF ON THEN
05375 BEGIN "NEXT TAB"
05400 POSN←POSN+SPCS; XPOSN←XPOSN+XSPLEN(SPCS); SPCS←0;
05500 DO BEGIN TABI←TABI+1; N←TABSORT[TABI] END
05600 UNTIL N>TWO(15) OR (IF XCRIBL THEN N*CHARW>XPOSN ELSE N>POSN);
05700 IF N>TWO(15) THEN
05800 BEGIN TES 8/26/74 "ONLY"? ;
05900 WARN("BAD TAB", <IF N=TWO(33) THEN NULL
06000 ELSE "TABBED PAST LAST TAB STOP">) ;
06100 TABI←TABI-1; N←POSN+2;
06200 END;
06300 TES 8/19/74 IF NO TAB SET, LEAVE A SPACE ;
06400 TABTO(N) ; IF N > NMAXIM+LMARG THEN TABI ← TABI - 1 ;
06500 END "NEXT TAB" ;
06600 COMMENT 8 ... ∂ ;
06650 IF ENDOFSEGMENT THEN EMIT(BRC)
06700 ELSE
06750 BEGIN "SPECIFIC TAB"
06800 SPCS←0 ;
06900 CHR ← LOP(INPUTSTR) ;
07000 IF (PLUS ← CHR)="+" OR CHR="-" THEN CHR ← LOP(INPUTSTR) ELSE PLUS←0 ;
07100 IF CHR="(" THEN
07200 BEGIN
07300 PASS ; N ← CVD(E("0",0)) ;
07400 IF NOT ITSCH(<)>) THEN WARN("=",<"Missed ) after ∂(...">) ;
07500 END
07600 ELSE IF (F←LDB(FAMILY(CHR)))=0 THEN N←
07700 CVD( EVALV(SYM[N←SYMNUM(CAPITALIZE(CHR))],
07750 LDB(IXN(N)), LDB(TYPEN(N)))) TES 8/19/74 FIX BUG ;
07800 ELSE IF F = DIGQ THEN N ← CHR - 48 comment, Digit ;
07900 ELSE BEGIN WARN("=","Unintelligible ∂ Construct") ; N ← 0 END ;
08000 IF PLUS="-" THEN
08100 BEGIN "BACKSPACE"
08200 EMIT(NULL) ; STARPOSN ← POSN MAX STARPOSN ;
08300 IF XCRIBL
08305 IFC PARCVER THENC TES 10/9/74 ;
08310 AND (ABS(DEVICE)=XGP OR N=1)
08315 ENDC
08320 THEN
08400 BEGIN
08500 APPEND(FONTCHAR&'35&
08550 (IF ENDOFSEGMENT THEN SP ELSE LOP(INPUTSTR)));
08600 IF N NEQ 1 THEN
08700 WARN("=","Can't backspace more than one!!");
08800 END
08900 ELSE
09000 BEGIN
09100 POSN ← POSN-N MAX 0 ;
09110 IFC PARCVER THENC TES 10/9/74 ;
09120 IF ABS(DEVICE)=MIC THEN
09130 XPOSN ← XPOSN-N*CHARW MAX 0 ;
09140 ENDC
09200 APPEND(FONTCHAR&PLUS&CVSR(N)) ;
09300 END;
09400 END
09500 ELSE IF PLUS="+" AND NULSTR(LBF) THEN
09600 BEGIN
09700 IF N>0 THEN
09750 BEGIN
09775 APPEND(FONTCHAR&"+"&CVSR(IF XCRIBL THEN N*CHARW ELSE N));
09800 POSN←POSN+N MIN NMAXIM+LMARG ;
09850 END;
09900 END
10000 ELSE TABTO((IF PLUS="*" THEN STARPOSN ELSE
10100 IF PLUS="+" THEN POSN+N ELSE N) MIN NMAXIM+LMARG) ;
10200 END "SPECIFIC TAB" ;
10300 COMMENT 9 ... ← ; IF LBK NEQ 2 THEN BOUND(1) ELSE EMIT(BRC) ;
10400 COMMENT 10 ... → ; IF LBK NEQ 2 THEN BOUND(2) ELSE EMIT(BRC) ;
10500 COMMENT 11 ... ∞ ; IF (N←INPUTSTR)=CR OR N=ALTMODE THEN WARN("=","∞ What?")
10600 ELSE BOUND(-LOP(INPUTSTR)) ;
10700 COMMENT 12 ... ↑ ;
10750 IF ON AND (CHR←INPUTSTR) NEQ CR AND CHR NEQ ALTMODE THEN SCRIPT("↑")
10775 ELSE EMIT(BRC) ;
10800 COMMENT 13 ... ↓ ;
10850 IF ON THEN IF ENDOFSEGMENT THEN EMIT(BRC)
10900 ELSE IF LDB(SPCODE(INPUTSTR))=UNDERBAR THEN
11000 BEGIN
11100 LOPP(INPUTSTR) ; EMIT(NULL) ;
11200 IF POSN LEQ MAXIM OR XCRIBL THEN
11250 BEGIN
11275 IF UNDERLINING=0 THEN APPEND(FONTCHAR&"_") ;
11287 UNDERLINING←2 ;
11293 END ;
11300 END
11400 ELSE SCRIPT("↓") ;
11500 COMMENT 14 ... ] ; IF SUPERSUB AND ON THEN UNSCRIPT(0)
11600 ELSE EMIT(BRC) ;
11700 COMMENT 15 ... hyphen ;
11750 IF MIDWORD AND FILL AND ON AND NOT SUPERSUB THEN
11800 BEGIN
11900 EMIT("-") ; OKCR(FALSE) ;
12000 IF INPUTSTR=CR THEN
12050 BEGIN
12075 LOPP(INPUTSTR) ;
12087 TEXTMODE ← FALSE ;
12093 END ;
12100 END
12200 ELSE BEGIN N←MIDWORD ; EMIT(BRC) ; MIDWORD ← N END ;
12300 COMMENT 16 ... .!? ;
12350 IF MIDWORD AND FILL AND ON AND NOT SUPERSUB THEN
12375 BEGIN
12387 EMIT(BRC) ;
12393 PUNC←TRUE ;
12396 END
12400 ELSE EMIT(BRC) ;
12500 COMMENT 17 ... space ; EMSPACES(1 + LENGTH(RD(TO!NON!SP)) ) ;
12600 COMMENT 18 ... underline ;
12650 IF LDB(SPCODE(INPUTSTR))=DARROW AND ON THEN
12700 BEGIN
12800 LOPP(INPUTSTR) ; EMIT(NULL) ;
12900 IF UNDERLINING THEN
13000 ENDERLINE: BEGIN
13100 UNDERLINING ← 0 ;
13200 IF POSN LEQ MAXIM OR XCRIBL THEN APPEND(FONTCHAR&"≡") ;
13300 END ;
13400 END
13500 ELSE BEGIN COMMENT BARE UNDERLINE ;
13550 EMIT(NULL) ;
13600 IF POSN LEQ MAXIM OR XCRIBL THEN
13650 IFC PARCVER THENC TES 10/11/74 ;
13700 IF ABS(DEVICE)=MIC AND FULSTR(VUNDERLINE) THEN
13750 EMITPIECE(IF UNDERLINING THEN "_"
13800 ELSE FONTCHAR&"_"&VUNDERLINE&FONTCHAR&"≡",
13850 1, CW[SP])
13900 ELSE
13950 ENDC
14000 EMIT(IF NULSTR(VUNDERLINE) THEN " " ELSE VUNDERLINE) ;
14050 END ;
14200 COMMENT 19 ... π ; TES 11/29/73 ;
14300 IF FULSTR(PIECE←PICHAR[CHR←INPUTSTR]) THEN
14400 BEGIN
14500 F ← LOP(PIECE) ; N ← LOP(PIECE) ;
14600 PIECE ← MASH(PIECE) ; TES 8/14/74 ;
14700 IF ON THEN
14800 EMITPIECE(FONTCHAR & "π" & LENGTH(PIECE) & PIECE,
14900 IF XCRIBL OR F='177 THEN 1 ELSE 128*F+N, TES 9/26/74 ;
15000 IF NOT XCRIBL THEN 0
15100 ELSE IF F='177 THEN CW[N]
15200 ELSE 128*F+N) ;
15300 LOPP(INPUTSTR) ;
15400 END
15500 ELSE EMIT(BRC) ;
15600 COMMENT 20 ... ∪ ;
15650 IF ON AND UNDERLINING=0 THEN
15700 BEGIN COMMENT ∪NDERLINE ONE WORD ;
15800 EMIT(NULL) ; UNDERLINING ← 1 ;
15900 IF POSN<MAXIM OR XCRIBL THEN APPEND(FONTCHAR & "_") ;
16000 IF FULSTR(PIECE←RD(ALPHA)) THEN EMIT(PIECE) ;
16100 GO TO ENDERLINE ;
16200 END ;
16300 COMMENT 21 ... ∩ ; EMIT(BRC) ; COMMENT CURRENTLY NOT USED ;
16400 COMMENT 22 ... VT ;
16450 WARN("=", <"Vertical tab found on a text line; either you typed <ctrl>K or" & CRLF &
16500 "you put a Horseshoe, )$, or ↑P (Template End) on a text line" & CRLF &
16600 "See Rule(1) on p.24 of manual">) ;
16700 COMMENT 23 ... $ ; IF LDB(SPCODE(INPUTSTR))=LBRACK THEN
16800 BEGIN LOPP(INPUTSTR) ; TEXTMODE ← FALSE END ELSE EMIT(BRC) ; TES REM ERROR 6/11/74;
16900 COMMENT 24 ... % ;
16950 IF ON THEN
17000 BEGIN "PERCENT"
17100 CHR←LOP(INPUTSTR);
17200 IF CHR="*" THEN F←OLDFONT
17300 ELSE IF (F ← RFONT(CHR)) < 0 THEN TES 11/29/73 RFONT;
17400 BEGIN WARN("=","Illegal font '"&CHR&"'"); F←0 END;
17500 IF F>0 AND FNTFIL[F]=0 THEN
17600 BEGIN
17700 IF XCRIBL THEN TES 11/5/73 ;
17800 WARN("=","Unknown font '"&CHR&"'");
17900 F←0;
18000 END;
18100 IF F AND XCRIBL THEN
18200 BEGIN
18300 EMIT(NULL);
18400 IF F NEQ THISFONT THEN APPEND(PICKFONT(F)) ;
18500 SWITCHFONT(F) ; TES 11/15/73 SUBROUTINIZED ;
18600 END;
18700 END;
18800 COMMENT 25 ... ⊗ ; EMIT(BRC) ; comment PASS 3 control only, no action here ;
18900 COMMENT 26 ... [ ; EMIT(BRC) ; comment just to be safe ;
19000 COMMENT 27 ... & ; EMIT(BRC) comment just to be safe ;
19100 END ; COMMENT BY BRC ;
19200 END ;
19300 END "SCANTEXT" ;
00100 PUBLIC SIMPLE PROCEDURE TURN(INTEGER CHR,FUN,ONOFF) ;$"#
00200 BEGIN "TURN"
00300 INTEGER CODE, X, M, STDCHR ; BOOLEAN HADCHR, DEFD ; LABEL FIN ;
00400 DEFD ← FALSE ; CODE ← LDB(SPCODE(CHR)) ; STDCHR ← LDB(SPCHAR(FUN)) ;
00500 IF CHR=TB THEN
00600 BEGIN
00700 DPB(TABTAB ← IF ONOFF THEN FUN ELSE 0, SPCODE(CHR)) ;
00800 GO TO FIN ;
00900 END
01000 ELSE IF NOT CODE THEN HADCHR ← FALSE
01100 ELSE IF CODE=STDCHR AND ONOFF THEN GO TO FIN COMMENT ALREADY ON ;
01200 ELSE IF NOT ONOFF OR NOT STDCHR THEN
01300 BEGIN COMMENT REMOVE CHARACTER FROM BREAK TABLE STRING ;
01400 HADCHR ← TRUE ; X ← LENGTH(TEXT!BRC) ;
01500 START!CODE "FINDIT"
01600 LABEL NEXC, DUN ;
01700 MOVE 1, TEXT!BRC ; SKIPN 2, X ; JRST DUN ;
01800 NEXC: ILDB 3,1 ; CAMN 3, CHR ; JRST DUN ; SOJG 2, NEXC ;
01900 DUN: MOVEM 2, M ;
02000 END ;
02100 TEXT!BRC ← TEXT!BRC[1 TO X-M] & TEXT!BRC[X-M+2 TO X] ;
02200 END ;
02300 IF ONOFF THEN
02400 BEGIN "ON" COMMENT REV. 2/20/73 TES ;
02500 IF STDCHR=XCMDCHR THEN DOPASS3←TRUE; RKJ: 1-4-74;
02600 IF STDCHR AND STDCHR < LBRACK THEN TEXT!BRC ← TEXT!BRC & CHR ;
02700 IF FUN="{" AND NOT FIND!CHR(CHR) THEN
02800 BEGIN
02900 DEFN!BRC ← CHR & DEFN!BRC ;
03000 DEFD ← TRUE ;
03100 END ;
03200 DPB(STDCHR, SPCODE(CHR)) ;
03300 END "ON"
03400 ELSE BEGIN "OFF" COMMENT REV. 2/20/73 TES ;
03500 INTEGER I ;
03600 IF FUN = "{" AND (I ← FIND!CHR(CHR)) THEN
03700 BEGIN
03800 DEFN!BRC ← DEFN!BRC[1 TO I-1] & DEFN!BRC[I+1 TO ∞] ;
03900 DEFD ← TRUE ;
04000 END ;
04100 IF HADCHR THEN DPB(0, SPCODE(CHR)) ;
04200 END "OFF" ;
04300 SETBREAK(TEXT!TBL, TEXT!BRC&SIG!BRC, NULL, "IS") ;
04400 IF DEFD THEN SETBREAK(DEFN!TABLE, DEFN!BRC, NULL, "IS") ;
04500 FIN:
04600 IF ONOFF LEQ 0 THEN ISTK[PUSHI(TURNWDS, TURNTYPE) - 1] ←
04700 CHR LSH 7 LOR (IF CHR=TB THEN CODE ELSE CHARSP[CODE FOR 1]) ;
04800 END "TURN" ;
00100 FINISHED
00200
00300 ENDOF("CTRLC")